Amiga Format CD 52/Amiga Format AFCD52 (Issue 136, May 2000).iso/-readerstuff-/antony_dzeryn/introcreate/source/introcreate.amos/introcreate.amosSourceCode

AMOS Source Code | 2000-02-24 | 5KB | 266 lines

FILE$=Command Line$
Erase All
Global F0NT,FILE$,FAD3,CH3CK,GAME$,GRACPLAYER$
FAD3=1
CH3CK=1
D$=Dir$
Procedure PICIN[PIC$]
   Screen Open 0,320,256,32,Lowres
   Colour 1,0
   Curs Off
   Flash Off
   Hide
   If PIC$<>"nil"
      Load PIC$,1
      Unpack 1 To 0
      If FAD3=1
         NICEIFF[0]
      End If
   End If
End Proc
Procedure PICOUT
   Screen 0
   If FAD3=1
      Fade 2
   Else
      Screen Close 0
   End If
   Wait 40
End Proc
Procedure TXT[X,Y,TXT$,SPEED]
   Screen Open 1,320,57,16,Lowres
   Screen Display 1,140,250,320,57
   Colour 1,0
   Curs Off
   Flash Off
   Hide
   Set Font F0NT
   Text X,Y,TXT$
   If FAD3=1
      NICEIFF[1]
   End If
   Wait SPEED
   If FAD3=1
      Fade 2
   Else
      Screen Close 1
   End If
   Wait 40
End Proc
Procedure TXT2[X,Y,TXT$,SPEED]
   Screen Open 0,320,256,16,Lowres
   Colour 1,0
   Curs Off
   Flash Off
   Hide
   Set Font F0NT
   Text X,Y,TXT$
   If FAD3=1
      NICEIFF[0]
   End If
   Wait SPEED
   If FAD3=1
      Fade 2
   Else
      Screen Close 0
   End If
   Wait 40
End Proc
Procedure ST[ST$]
   Erase 3
    Extension_19_0006 ST$,3
End Proc
Procedure STPLY[BLOCK]
   If BLOCK=-1
       Extension_19_0030
      Pop Proc
   Else
       Extension_19_0016 3,BLOCK
   End If
End Proc
Procedure NICEIFF[SFADE]
   Auto View Off
   Screen SFADE
   Screen Clone 3
   Screen To Front SFADE
   For W=0 To 31
      Colour W,0
      If Mouse Key<>0 and CH3CK=1
         PICOUT
         Screen 1
         Fade 1
         Wait 20
         Erase All
         Kill "RAM:"+FILE$
         Command Line$=GAME$
         Run D$+GRACPLAYER$
      End If
   Next
   View
   Auto View On
   Screen Show SFADE
   Screen SFADE
   Fade 1 To 3
   Screen Close 3
   WA1T[15]
End Proc
Procedure WA1T[WA1T]
   For Q=1 To WA1T
      Wait 1
      If Mouse Key<>0 and CH3CK=1
         PICOUT
         Screen 1
         Fade 1
         Wait 20
         Erase All
         Kill "RAM:"+FILE$
         Command Line$=GAME$
         Run D$+GRACPLAYER$
      End If
   Next
End Proc
Procedure FIN
   Erase All
   Close 1
   Kill "RAM:"+FILE$
   Command Line$=GAME$
   Run D$+GRACPLAYER$
End Proc
Procedure FONTDIR[D1R$]
   Assign "Fonts:" To D1R$
   Get Disc Fonts
End Proc
Procedure G3TFONTS[NAMELENGTH,F0NTSIZE$,F0NTNAME$]
   Repeat
      A=A+1
      A$=Font$(A)
      If Left$(A$,NAMELENGTH)=F0NTNAME$
         A$=Right$(A$,Len(A$)-30)
         If Left$(A$,2)=F0NTSIZE$
            F0NT=A
         End If
      End If
   Until F0NT>0
End Proc
Procedure CL0SEWB
   Close Workbench
   Amos To Front
   Amos Lock
End Proc
Exec "C:Copy "+Chr$(34)+FILE$+Chr$(34)+" To RAM:"
Open In 1,"RAM:"+FILE$
Set Input 10,-1
For A=1 To 10000
   Line Input #1,A$

   If Left$(A$,10)="gracplayer"
      GRACPLAYER$=Right$(A$,Len(A$)-11)
   End If

   If Left$(A$,4)="game"
      GAME$=Right$(A$,Len(A$)-5)
   End If

   If Left$(A$,3)="txt"
      A$=Right$(A$,Len(A$)-4)
      A1=Val(Left$(A$,3))
      A$=Right$(A$,Len(A$)-4)
      A2=Val(Left$(A$,3))
      A$=Right$(A$,Len(A$)-3)
      A3=Val(Right$(A$,3))
      A$=Left$(A$,Len(A$)-4)
      TXT[A1,A2,A$,A3]
   End If

   If Left$(A$,3)="fxt"
      A$=Right$(A$,Len(A$)-4)
      A1=Val(Left$(A$,3))
      A$=Right$(A$,Len(A$)-4)
      A2=Val(Left$(A$,3))
      A$=Right$(A$,Len(A$)-3)
      A3=Val(Right$(A$,3))
      A$=Left$(A$,Len(A$)-4)
      TXT2[A1,A2,A$,A3]
   End If

   If Left$(A$,8)="fontname"
      A$=Right$(A$,Len(A$)-9)
      B$=Right$(A$,2)
      A$=Left$(A$,Len(A$)-3)
      A=Len(A$)
      G3TFONTS[A,B$,A$]
   End If

   If A$="noquit"
      Break Off
   End If

   If A$="closewb"
      CL0SEWB
   End If

   If Left$(A$,6)="filter"
      If Right$(A$,2)="on"
         Led On
      End If
      If Right$(A$,3)="off"
         Led Off
      End If
   End If

   If Left$(A$,4)="fade"
      If Right$(A$,2)="on"
         FAD3=1
      End If
      If Right$(A$,3)="off"
         FAD3=0
      End If
   End If

   If Left$(A$,10)="checkmouse"
      If Right$(A$,2)="on"
         CH3CK=1
      End If
      If Right$(A$,3)="off"
         CH3CK=0
      End If
   End If

   If Left$(A$,5)="picin"
      A$=Right$(A$,Len(A$)-6)
      PICIN[A$]
   End If

   If Left$(A$,6)="picout"
      PICOUT
   End If

   If Left$(A$,6)="playst"
      A$=Right$(A$,2)
      BLOCK=Val(A$)
      STPLY[BLOCK]
   End If

   If Left$(A$,2)="st"
      A$=Right$(A$,Len(A$)-3)
      ST[A$]
   End If

   If A$="fin"
      FIN
   End If

   If Left$(A$,4)="wait"
      A1=Val(Right$(A$,Len(A$)-5))
      WA1T[A1]
   End If

   If Left$(A$,7)="fontdir"
      A$=Right$(A$,Len(A$)-8)
      FONTDIR[A$]
   End If

   If Eof(1)=-1
      FIN
   End If
Next A